home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / Commands.tcl < prev    next >
Encoding:
Text File  |  2004-05-25  |  13.0 KB  |  451 lines
  1. ##############################################################################
  2. ##############################################################################
  3. #                               Commands.tcl
  4. ##############################################################################
  5. ##############################################################################
  6. # Here you will implemented a few helpful procedures that don't quite fit   
  7. # anywhere else.
  8. ##############################################################################
  9. ##############################################################################
  10. # Copyright 2000-2001 AndrΘs Garcφa Garcφa  -- fandom@retemail.es
  11. # Distributed under the terms of the GPL v2
  12. ##############################################################################
  13. ##############################################################################
  14.  
  15. namespace eval Commands {
  16.  
  17. set sedIndex 0
  18.  
  19. ##############################################################################
  20. # PlaceWindow
  21. #    Places a given window in the screen, it makes sure the window won't go
  22. #    out of the screen, unless it is way too big of course.
  23. #
  24. # Parameters:
  25. #    win: Path of the window.
  26. #    x,y: The coordinates where we want the top-left corner to be placed, 
  27. #         unless that wouldn't allow the the whole window to be seen.
  28. #    width,height: Width and height of the window.
  29. ##############################################################################
  30. proc PlaceWindow {win x y width height} { 
  31.  
  32.     set screenWidth  [winfo screenwidth  $win]
  33.     set screenHeight [winfo screenheight $win]
  34.  
  35.     if {[expr $x + $width + 15]>$screenWidth} {
  36.         set x [expr {$screenWidth - $width - 15}]
  37.     }
  38.     if {[expr $y + $height + 30]>$screenHeight} {
  39.  
  40.         set y [expr {$screenHeight - $height - 30}]
  41.     }
  42.     if {$x<0} {
  43.         set x 0
  44.     }
  45.     if {$y<0} {
  46.         set y 0
  47.     }
  48.     wm geometry $win ${width}x$height+$x+$y
  49.     return
  50. }
  51.  
  52. ##############################################################################
  53. # Touch
  54. #    This procedure will create an empty file
  55. #
  56. # Parameters:
  57. #    fileName: The file to create.
  58. ##############################################################################
  59. proc Touch {fileName} {
  60.  
  61.     if {![file exists "$fileName"]} {
  62.         set handle [open "$fileName" w]
  63.         close $handle
  64.     }
  65.     return
  66. }
  67.  
  68. ##############################################################################
  69. # SedReadFile
  70. #    Reads a given file into memory for the pseudosed command to work on.
  71. #
  72. # Parameters:
  73. #    fileName: The file to read.
  74. #
  75. # Returns:
  76. #    - '0' if all went well.
  77. #    - '1' if not.
  78. ##############################################################################
  79. proc SedReadFile {fileName} {
  80.     variable workFile 
  81.     variable workFileLines
  82.  
  83.     catch {unset workFile}
  84.     if {[catch {open "$fileName" r} handle]} {
  85.         return 1
  86.     }
  87.     set workFileLines ""
  88.     for {set i 0} {![eof $handle]} {incr i} {
  89.         set workFile($i) [gets $handle]
  90.         if {[regexp {=} $workFile($i)]} {
  91.             lappend workFileLines $i
  92.         }            
  93.     }
  94.     close $handle
  95.  
  96.     return 0
  97. }
  98.  
  99. ##############################################################################
  100. # SedWriteFile
  101. #     Saves whatever is in the workFile array into the given file. The file
  102. #     must not already exist.
  103. #
  104. # Parameter:
  105. #     fileName: file to use to save the data.
  106. #
  107. # Returns:
  108. #    - '0' if all went well.
  109. #    - '1' if not.
  110. ##############################################################################
  111. proc SedWriteFile {fileName} {
  112.     variable workFile
  113.  
  114.     if {[catch {open "$fileName" w} handle]} {
  115.         return 1
  116.     }
  117.     for {set i 0} {![catch "set workFile($i)"]} {incr i} {
  118.         puts $handle "$workFile($i)"
  119.     }
  120.     close $handle
  121.  
  122.     return 0
  123. }
  124.  
  125. ##############################################################################
  126. # DeRexString
  127. #     Prepares a string so that it is safe to use it in a regular expresion,
  128. #     for example, all '+' are changed to '\+'.
  129. #
  130. # Parameters:
  131. #    - old: The string to make safe.
  132. #
  133. # Returns:
  134. #    The string now safe.
  135. ##############################################################################
  136. proc DeRexString {old} {
  137.  
  138.     set old [string map {../ \\.\\./ ./ \\./ * \\* + \\+ ? \\? ) \\)      \
  139.             ( \\( ] \\] [ \\[ $ \\$} $old]
  140.  
  141.     return $old
  142. }
  143.  
  144. ##############################################################################
  145. # SedChangeEnter
  146. #     Enters a new change in to the 'sedChanges' array.
  147. #
  148. # Parameters:
  149. #    - old: The regular expresion to subtitute.
  150. #    - new: The substitute.
  151. ##############################################################################
  152. proc SedChangeEnter {old new} {
  153.     variable sedChanges
  154.     variable sedIndex
  155.  
  156.     if {$old==$new} {
  157.         return
  158.     }
  159.  
  160.     if {$new==""} {
  161.         set sedChanges($sedIndex,old) $old
  162.         set sedChanges($sedIndex,new) $new
  163.  
  164.         incr sedIndex
  165.  
  166.         set sedChanges($sedIndex,old) ""
  167.         set sedChanges($sedIndex,new) ""
  168.  
  169.         incr sedIndex
  170.  
  171.         return
  172.     }
  173.  
  174.     set old [DeRexString $old]
  175.     regsub -all {&}   $new {\\&}  new
  176.  
  177.     set oldLink "(href|src)(\\s*)(=)(\\s*)(\'|\")($old)(\"|\')"
  178.     set newLink "\\1=\"$new\""
  179.  
  180.     set sedChanges($sedIndex,old) $oldLink
  181.     set sedChanges($sedIndex,new) $newLink
  182.  
  183.     set oldLink "(href|src)(\\s*)(=)(\\s*)($old)(\ |>)" 
  184.     set newLink "\\1=\"$new\"\\6"
  185.  
  186.     incr sedIndex
  187.  
  188.     set sedChanges($sedIndex,old) $oldLink
  189.     set sedChanges($sedIndex,new) $newLink
  190.  
  191.     incr sedIndex
  192.  
  193.     return
  194. }
  195.  
  196. ##############################################################################
  197. # SedChange
  198. #     Goes through the file in 'workFile' chaging one link.
  199. #
  200. # Parameter:
  201. #     index: The index of the link to change in the sedChanges variable.
  202. #
  203. # Returns:
  204. #    - '0' if there was no change.
  205. #    - '1' if a change was found.
  206. ##############################################################################
  207. proc SedChange {index} {
  208.     variable workFile
  209.     variable sedChanges
  210.     variable startLine
  211.     variable workFileLines
  212.  
  213.     set old $sedChanges($index,old)
  214.     set new $sedChanges($index,new)
  215.     for {set i $startLine} {1} {incr i} {
  216.         set line [lindex $workFileLines $i]
  217.         if {$line==""} {
  218.             break
  219.         }
  220.         if {[regsub -nocase "$old" $workFile($line) "$new" workFile($line)]} {
  221.             set startLine $i
  222.             return 1
  223.         }
  224.     }
  225.     return 0
  226. }
  227.  
  228. ############################################################################
  229. # Sed
  230. #     Goes through a given file and makes the requested changes to it.
  231. #
  232. # Parameter:
  233. #     fileName: file to change.
  234. #
  235. # Returns:
  236. #    - '0' if all went well.
  237. #    - '1' if not.
  238. ##############################################################################
  239. proc Sed {fileName} {
  240.     variable workFile
  241.     variable sedChanges
  242.     variable sedIndex
  243.     variable startLine
  244.  
  245.     if {[file exists $fileName.html]} {
  246.         set fileName $fileName.html
  247.     }
  248.     if {[SedReadFile $fileName]==1} {return 1}
  249.  
  250.     for {set i 0 ; set startLine 0} {![catch "set sedChanges($i,old)"]} {incr i} {
  251.         if {([SedChange $i]==1)&&([expr {$i%2}]==0)} {
  252.             incr i    
  253.         }
  254.     }
  255.  
  256.     catch {unset sedChanges}
  257.     set sedIndex 0
  258.  
  259.     if {[SedWriteFile $fileName]==1} {return 1}
  260.  
  261.     return 0
  262. }
  263.  
  264. ###############################################################################
  265. # ChangePage
  266. #    Changes a html page, so that there is consistency with the local
  267. #    directories. After this procedure is run through a page all it's links
  268. #    should be between double qoutes ("), the ones that have been downloaded
  269. #    will be relative to the the current directory and the ones that where
  270. #    not downloaded will have the complete url.
  271. #
  272. # Parameters
  273. #    url: The url of the page about to be changed.
  274. ###############################################################################
  275. proc ChangePage {url} {
  276.     global siteUrl
  277.     global directories
  278.  
  279.     if {$HtmlParser::baseTag!=""} {
  280.         Commands::SedChangeEnter <$HtmlParser::baseTag> ""
  281.     }
  282.  
  283.     for {set i 1} {$i<$HtmlParser::nLinks} {incr i} {
  284.         set link    $HtmlParser::links($i,file)
  285.         # Even if we now filter the file out, it may already be there
  286.         # due to a former download.
  287.         set file    [UrlToFile $HtmlParser::links($i,url) $directories(base)]
  288.         if {($HtmlParser::links($i,ok)==1)||([file exists $file])} {
  289.             set tag ""
  290.             regexp {(#)(.*)} $HtmlParser::links($i,url) tag
  291.             set newLink [RelativePath $url $HtmlParser::links($i,url)]
  292.             Commands::SedChangeEnter $link $newLink$tag
  293.         } else {
  294.             set newLink $HtmlParser::links($i,url)
  295.             if {$link!=$newLink} {
  296.                 Commands::SedChangeEnter $link $newLink
  297.             }
  298.         }
  299.     }
  300.  
  301.     set fileName [UrlToFile $url $directories(base)]
  302.     if {[file exists $fileName.orig]} {
  303.         file copy -force $fileName.orig $fileName
  304.     } elseif {[file exists $fileName.html.orig]} {
  305.         file copy -force $fileName.html.orig $fileName.html
  306.     } elseif {[file exists $fileName.html]} {
  307.         file copy $fileName.html $fileName.html.orig
  308.     } else {
  309.         file copy $fileName $fileName.orig
  310.     }
  311.  
  312.     Commands::Sed $fileName
  313.  
  314.     return    
  315. }
  316.  
  317. ###############################################################################
  318. # UrlToFile
  319. #    Given an Url this procedure will return the file in which it will be
  320. #    saved.
  321. #
  322. #    Extra care since Windows doesn't like certain names for directories.
  323. #
  324. # Parameters
  325. #    url: The url to process.
  326. #    baseDir: The local directory into which the site is saved.
  327. #
  328. # Returns:
  329. #    The file in which it will be saved complete with full path.
  330. ###############################################################################
  331. proc UrlToFile {url {baseDir ""}} {
  332.     global getleftState
  333.  
  334.     set parsedUrl [HtmlParser::ParseUrl $url]
  335.     set prot      [lindex $parsedUrl 0]
  336.     set domain    [string tolower [lindex $parsedUrl 1]]
  337.     set dir       [lindex $parsedUrl 2]
  338.     set file      [lindex $parsedUrl 3]
  339.  
  340.     if {$file==""} {
  341.         if {$prot=="ftp"} {
  342.             set file index.txt
  343.         } else {
  344.             set file index.html
  345.         }
  346.     }
  347.  
  348.     set fileName ${domain}$dir/$file
  349.     set fileName [TidyNames $fileName]
  350.     while {[regexp {(?:%)([0-9ABCDEFabcdef][0-9ABCDEFabcdef])} $fileName nada tmp]} {
  351.         if {$tmp=="26"} {
  352.             set newTmp \\&
  353.         } else {
  354.             set newTmp [format "%c" "0x$tmp"]
  355.         }
  356.         regsub -all "%$tmp" $fileName "$newTmp" fileName
  357.     }
  358.  
  359.     if {$baseDir==""} {
  360.         set baseDir $::directories(base)
  361.     }
  362.  
  363.     set fileName [file join $baseDir $fileName]
  364.  
  365.     if {$getleftState(os)=="win"} {
  366.         regsub -nocase {(/)(com[1-9]|aux|nul|con|lpt[1-9])(/|\.|$)} $fileName    \
  367.                 {/g\2\3} fileName
  368.     }
  369.  
  370.     return $fileName
  371. }
  372.  
  373. ###############################################################################
  374. # TidyNames
  375. #    Removes from the name and path of files things like '?' '~' '+' '-'
  376. #
  377. # Returns
  378. #    The filename without those characters.
  379. ###############################################################################
  380. proc TidyNamesOld {nombre} {
  381.  
  382.     regsub -all {~}  $nombre {} nombre
  383.     regsub -all {\*} $nombre {} nombre
  384.     if {[regexp {(?:^.:)(.*)} $nombre nada filename]} {
  385.         regsub -all {:}  $filename {} filename
  386.         set nombre $filename
  387.     } else {
  388.         regsub -all {:} $nombre {} nombre
  389.     }
  390.     if {[regexp {([^\?]+)(?:\?)(.*)} $nombre nada uno dos]} {
  391.         regsub -all {\?} $dos {} dos
  392.         regsub -all {\+} $dos {} dos
  393.         regsub -all {/}  $dos {} dos
  394.         regsub -all {\\} $dos {} dos
  395.         set nombre $uno$dos
  396.     }
  397.     return $nombre
  398. }
  399.  
  400. proc TidyNames {nombre} {
  401.     set nombre [string map     {~ "" * ""} $nombre]
  402.     regsub {(^.:)(.*)} $nombre {}           nombre
  403.     set nombre [string map     {: ""}      $nombre]
  404.  
  405.     if {[regexp {([^\?]+)(?:\?)(.*)} $nombre nada uno dos]} {
  406.         set dos [string map {? "" + "" / "" \\ ""} $dos]
  407.         set nombre $uno$dos
  408.     }
  409.     return $nombre
  410. }
  411.  
  412. ###############################################################################
  413. # RelativePath
  414. #    The function returns the relative path from the referer page to the linked
  415. #    page.
  416. #
  417. # Parameter:
  418. #    urlRef. The referer page.
  419. #    urlNew: The url whose link we are calculating.
  420. #
  421. # Returns:
  422. #    The link for the changed page.
  423. ###############################################################################
  424. proc RelativePath {urlRef urlNew} {
  425.     global directories siteUrl
  426.  
  427.     set fileRef [UrlToFile $urlRef $directories(base)]
  428.     set fileNew [UrlToFile $urlNew $directories(base)]
  429.  
  430.     regexp -nocase "(?:^$directories(base)/)(.*)" $fileRef nada fileRef
  431.     regexp -nocase "(?:^$directories(base)/)(.*)" $fileNew nada fileNew
  432.  
  433.     set listDirRef [split [file dirname $fileRef] /]
  434.     foreach dir $listDirRef {
  435.         regsub -all {\+} $dir {\\+} dir
  436.         if {[regexp "(?:^$dir/)(.*)" $fileNew nada fileNew]} {
  437.              regexp "(?:^$dir/)(.*)" $fileRef nada fileRef
  438.         } else {
  439.             break
  440.         }
  441.     }
  442.     set jumps [regsub -all {/} $fileRef {} nada]
  443.     for {set i 0} {$i<$jumps} {incr i} {
  444.         set fileNew ../$fileNew
  445.     }
  446.  
  447.     return $fileNew
  448. }
  449.  
  450. }
  451.